functor Inline (S : INLINE_STRUCTS) : INLINE =
struct
  open S
  
  structure I = Ir
  structure ErrorMsg = ErrorMsg
  
  local open I
  in structure Id = I.Id
     structure Intl = I.Intl
     structure B = I.Binop
     structure T = I.Types
     structure L = I.Le
     structure S = I.Structs
     structure M = I.Stm
     structure F = I.Function
     structure P = I.Program
  end

  val error = ErrorMsg.error

  val tag = true
  fun debugPrint s = 
      if tag
      then print (String.concat [s, "\n"])
      else ()
  fun debugPrintIdIntList s = 
      if tag
      then let val ss = String.concat ((List.map (fn (id, i) => 
                              String.concat ["(", Id.toString id, ", ", Int.toString i, ")"])) s)
           in  print (String.concat [ss, "\n"])
           end
      else ()
  
  val doAgain = ref false
  
  structure FuncNames :
  sig
    val all : Id.t list ref
    val allLeafs : Id.t list ref
    
    val enterLeaf : Id.t -> unit
    val init : unit -> unit
    val isEmptyLeaf : unit -> bool
    val memberAll : Id.t -> bool
    val removeLeaf : unit -> Id.t
  end =
  struct
    val all : Id.t list ref = ref []
    val allLeafs : Id.t list ref = ref []
    
    fun enterLeaf x = allLeafs := x :: (!allLeafs)
    
    fun init () = (all := []; allLeafs := [])
    
    fun memberAll id = List.exists (fn x => Id.equals (x, id)) (!all)
    
    fun isEmptyLeaf () =
        case !allLeafs
         of [] => true
          | _ => false
          
    fun removeLeaf () =
        case !allLeafs
         of [] => raise Fail "compiler bug"
          | x :: xs =>
            let val _ = allLeafs := xs
            in  x
            end
  end
  
  val {get = leaf, set = setLeaf, destroy = destroyLeaf, ...} =
      Property.destGetSet (Id.plist, Property.initConst false)
      
  val {get = callSites, set = setCallSites, destroy = destroyCallSites, ...} :
      {get : Id.t -> (Id.t * int) list, set : Id.t * (Id.t * int) list -> unit,
       destroy : unit -> unit} =
      Property.destGetSet (Id.plist, Property.initConst [])
  
  fun destroy () = (destroyLeaf (); destroyCallSites ())
      
  fun cfStm s =
      case s
       of M.AsnExp {lval, exp, ty, pos} => s
        | M.AsnCall {lval, fid, ty, exps, pos} => s
        | M.AsnAlloc {lval, ty, pos} => s
        | M.If (e, ss1, ss2, pos) =>
          M.If (e, cfStms ss1, cfStms ss2, pos)
        | M.While {invariant, condition, body, pos} =>
          M.While {invariant = invariant,
                   condition = condition,
                   body = cfStms body,
                   pos = pos}
        | _ => s
    and cfStms ss =
        case ss
         of [] => []
          | [M.Return _] =>
            ss
          | [_] => ss
          | (M.Return _) :: xs =>
            let val _ = doAgain := true
            in  cfStms xs
            end
          | x :: xs =>
            (cfStm x) :: (cfStms xs)
        
  fun shrinkStms ss =
      let val ss = cfStms ss
      in  if !doAgain
          then (doAgain := false; shrinkStms ss)
          else ss
      end
    
  fun shrinkFun f =
      case f
       of F.T {name,
               rettype,
               args,
               locals,
               stm,
               pre,
               post,
               pos} => 
          F.T {name = name,
               rettype = rettype,
               args = args,
               locals = locals,
               stm = shrinkStms stm,
               pre = pre,
               post = post,
               pos = pos}
               
  fun shrinkFuncs funcs = raise Fail "to do"
      
        
  fun calculateCallSites (name, numCalls) =
      case numCalls
       of [] => ()
        | (id, v) :: xs =>
          let val old = callSites id
              val _ = setCallSites (id, (name, v) :: old)
          in  calculateCallSites (name, xs)
          end
  
  fun select l =
      case l
       of [] => []
        | (id, v) :: xs =>
          if List.exists (fn x => Id.equals (x, id)) (!FuncNames.all)
          then (id, v) :: (select xs)
          else select xs
         
  fun annotateFun f =
      case f
       of F.T {name,
               rettype,
               args,
               locals,
               stm,
               pre,
               post,
               pos} =>
          let val numCalls = M.numCalls stm
              val _ = debugPrint (String.concat ["the calls in ", Id.toString name, " is:\n"])
              val _ = debugPrintIdIntList numCalls
              val numCalls = select numCalls
              val _ = debugPrint (String.concat ["the calls in ", Id.toString name, " is:\n"])
              val _ = debugPrintIdIntList numCalls
              val _ = case numCalls
                       of [] =>
                          let val _ = setLeaf (name, true)
                              val _ = FuncNames.enterLeaf name
                          in  ()
                          end
                        | _ => ()
              val _ = calculateCallSites (name, numCalls)
          in  ()
          end
          
  fun annotateFuncs funcs = List.app annotateFun funcs
          
  fun shrink p =
      case p
       of P.T {structs,
               gvars,
               funcs,
               pos} =>
          let val _ = FuncNames.init ()
              val _ = FuncNames.all := List.map F.name funcs
              val _ = annotateFuncs funcs
              val _ = shrinkFuncs funcs
              val _ = destroy ()
          in  p
          end
end
